00100	C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01200		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01300		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01400		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8))
01500		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01510		1,RDBR/5.0/,RBR/.33/,RBX/ 7.0/
01520	C  RDBR IS SPACER FOR DBL BAR.
01600	C  RTF COMPENSATES FOR BAD PLANNING.
01700		RST7=RSTJ2*7.
01800		RST18=RSTJ2*18.
01900	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02000	
02100		R3Q=R3
02200		JY=0
02300		IF(JA.EQ.6)GO TO 90
02400		IF(JA.EQ.8)GO TO 100
02500	C  GO TO LINES, BEAMS, STAVES.
02600	C   NEXT DRAWS STRAIGHT LINES
02700	
02800		RD=R4*RST7
02900		RA=0
03000		RX=RTF*RSTJ2+POS
03020	C  SOMEDAY ADD < RDIS=1./DIS >  TO REPLACE ALL 1./DIS'S
03100		IF(J5.EQ.50)GO TO 300
03150	C  50 IS FOR CRESC., DECRESC. AND BOXES
03200		IF(R6.NE.0)GO TO 401
03250		IF(J7.NE.0)GO TO 401
03400	C  FOR BAR LINES
03500	4000	JA=44
03600	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
03800	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
03850		DBR=0 
03860		IF(J4.LT.1000)GO TO 400
03870	C  J4=1001 = DBL BAR,  =1401 = DBL BAR WITH RT. ONE HEAVY
03880		J4=J4-1000
03890		DBR=-1
03900	400	J7=(J4/100)*DIS
04500		L=MOD(J4,100)+J2-1
04600	C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
04650		RY=RSTFAC(L)
04700		RY=STFF(L)+RTF*RY+RY*56.
04810	1400	RA=1
04820		IF(PLT.GE.0)GO TO 140
04830		J7=J7+1
04840		RA=1./DIS
04850	C  BAR LINES PLOT AS DOUBLE THICKNESS
04860	140	RJX=R3Q
04900	42	CALL LINES(R3Q,RX,3)
05200		RJ=-1.
05300		RW=RY
05400	406	CALL LINES(RJX,RY,2)
05500		IF(J10.EQ.0)GO TO 411
05600	C  P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
05700		J7=J10*DIS
05800		J10=0
05900		RA=1./DIS
05910	411	IF(J7.GT.0)GO TO 409
05920		IF(DBR.EQ.0)RETURN
05925		RY=RW
05930		R3Q=R3Q-RDBR
05935		DBR=0
05940		GO TO 1400
06000	CC411	IF(J7.LE.0)RETURN
06100	C  FOR 'HEAVY' LINE.
06200	409	RJX=RJX+RA
06300		CALL LINES(RJX,RY,2)
06400		J7=J7-1
06500		RY=RW
06600		IF(RJ)RY=RX
06700		RJ=-RJ
06800		GO TO 406
06900	CC43	IF(RA.LE.0)RETURN
07100	C   HOW IS RA.NE.0?
07200	C  DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
07300	CC403	RA=RA-3.72
07400	CC	R3Q=R3Q+22
07500	CC	RJX=RJX+22
07600	C   DO ABOVE NEED *RSTJ2? ************
07700	C **** BASED ON '596' ****
07800	CC	GO TO 42
07900	
08000	C  FOR CRESC., DECRESC.
08100	300	IF(R7.EQ.0)R7=2.3
08200		IF(R7.EQ.-1.)R7=-2.3
08300		RA=ABS(R7/2.0)*RST7
08400	C   AMOUNT OF SPREAD
08500		RJ=R3Q
08600		RX=RX-RST18+RD
08700		IF(R8.NE.0)GO TO 302
08800	C  JUMP TO MAKE BOX
08900		R6=RHORZ(R6)
09000		IF(R7)GO TO 301
09100		RJ=R6
09200		R6=R3Q
09300	301	CALL LINX(RJ,RX+RA,R6,RX)
09400		CALL LINES(RJ,RX-RA,2)
09500	C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
09600		IF(PLT.NE.-2)RETURN
09700		IF(J8)RETURN
09800		RX=RX+1./DIS
09900		J8=-1
10000	C FOR DOUBLE THICKNESS
10100		GO TO 301
10200	
10300	302	R8=R8*RST7
10400		R9=R9*RST7
10500		IF(R9.EQ.0)R9=R8
10600	C  R9=0 MAKES SQUARE    
10700		R3=R3Q-R8/2.
10800		RX=RX-R9/2.
10900		J10=J10*DIS
11000	C  DRAWS BOX, CENTER IS IN MIDDLE 
11100	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
11200	1302	CALL LINX(R3,RX,R3+R8,RX)
11300		CALL LINES(R3+R8,RX+R9,2)
11400		CALL LINES(R3,RX+R9,2)
11500		CALL LINES(R3,RX,2)
11600		IF(J10.EQ.0)RETURN
11700		J10=J10-1
11800		RJ=1./DIS
11900		R3=R3-RJ
12000		R8=R8+RJ+RJ
12100		RX=RX-RJ
12200		R9=R9+RJ+RJ
12300		GO TO 1302
12400	C  TO THICKEN BOXES.
12410	
12420	1401	R4=2.0
12440	C FOR HEAVY BRACK.
12450		RA=RSTJ2*RBX
12460		RX=RX-RA
12470	C  THE BOTTOM
12480		L=J4+J2-1
12485		RA=STFF(L)
12487	C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
12490		RJY=RSTFAC(L)
12500		RY=RA+RTF*RJY+RJY*56.+RJY*RBX
12510	C  THE TOP
12525		R5=9.5
12530		GO TO 2401
12540	
12600	C  DASHES
12700	401	POS=POS-RST18
12800	C********* 27/9/72 ******
12900		IF(J7.LE.0)GO TO 407
12910		IF(J7.EQ.4)GO TO 1401
12950		IF(J7.NE.3)GO TO 4001
12960	C  NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
12970	2401	JA=3
12975		IF(J10.EQ.0)J10=5
12977	C  DEFAULT VALUE FOR THICKNESS =5
12980		R4=R4-RBR
12985		J9=0
12990		J5=35
13000	C  THE NUM FOR THE LITTLE END ITEMS
13005	CC	RY=R6-2.1*RSTJ2
13010		R6=3 
13020		R7=0
13030	C DOES LOWER ONE FIRST.  ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
13040		IF(J8.NE.2)CALL CLEFS
13045	C P8=1=BOTTOM 1/2 BRACK. ONLY:  =2=TOP 1/2 ONLY:  0=COMPLETE
13050		R4=R5-RBR
13055		R6=3
13060		R7=-3
13063	C  TURNS IT UPSIDE DOWN.
13067	CC	JA=3
13071		IF(J7.NE.4)GO TO 3401
13073		POS=RA
13074		R4=R4*RJY/RSTJ2
13076	C  TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
13078	3401	IF(J8.NE.1)CALL CLEFS
13080		R3Q=R3Q-12.0*RSTJ2
13090		IF(J7.NE.4)GO TO 407
13100		J7=0
13110		GO TO 140
13155	
13200	4001	IF(R8.EQ.0)R8=.8
13300	C  P8 CAN SET SIZE OF DASH
13400		RD=RD+POS
13410		IF(J7.EQ.1)GO TO 402
13420	C  =1 =VERTICAL DASHES
13430		RA=RHORZ(R6)
13440		RST7=5.96*RSTJ2
13445		RJX=R3Q
13450		GO TO 420
13460	402	RA=POS+R5*RST7
13464		RJY=RD
13467	C  SAVE FOR THICK LINES
13470	420	RJ=R8*RST7
13524	41	L=3
13527		K=2
13530	416	CALL LINES(R3Q,RD,L)
13540		IF(J7.EQ.1)GO TO 412
13550	C  JUMP FOR VERTICAL DASH
13560		IF(R3Q.GE.RA)GO TO 413
13570	C  JUMP IF ALL DONE
13575		R3Q=R3Q+RJ
13580	414	CALL EXCH(L,K)
13590		GO TO 416
13600	412	IF(RD.GE.RA)GO TO 413
13610	C  JUMP IF DONE
13620		RD=RD+RJ
13630		GO TO 414
13640	413	IF(J10.LE.0)RETURN
13650	C  NEXT FOR THICK DASHES
13660		J10=J10-1
13670		IF(J7.EQ.1)GO TO 415
13680		R3Q=RJX
13685		RD=RD+1./DIS
13690		GO TO 41
13700	415	R3Q=R3Q+1./DIS
13705		RD=RJY
13710		GO TO 41
14300	
15700	
15800	407	RX=RD+POS
15810		RY=R5*RST7+POS
15855		IF(J7.EQ.3)GO TO 140
15900		CALL NOZERO(R9)
16000		IF(J7.EQ.-1)GO TO 408
16100	C  FOR 'TR' J7=-2, 'ARPEGG' J7=-1,  STRAIGHT LINES J7=0
16200	CC  WHY THE IFIX????	RJX=IFIX(RHORZ(R6))
16300		RJX=IFIX(ROFF(RHORZ(R6)))
16400	C  ALL THIS CRAP SO IT WILL MATCH UP WITH P2 WHEN NECESSARY.
16500		IF(J7.EQ.0)GO TO 42
16550		RY=R9*RST7+RX
16600		CALL NOZERO(R8)
16620	4041	RZ=RX
16640		RH=RY
16660	C  SAVE FOR THICK WIGGLES
16700		CALL LINES(R3Q,RX,3)
16800	C  DRAWS STRAIGHT LINES. ETC.
16900		R9=R3Q
17000		RJ=RY
17100		RW=3.*RSTJ2*R8
17200		RA=RW*2.5
17300	C  P8=HORZ. WIGGLE SIZE;  P9=VERT. SIZE
17400	404	R9=R9+RA
17500		CALL LINES(R9,RJ,2)
17600		R9=R9+RW
17700		CALL LINES(R9,RJ,2)
17800	405	CALL EXCH(RX,RJ)
17900		IF(R9.LT.RJX)GO TO 404
18000		IF(J10.LE.0)RETURN
18100		RX=RZ+1./DIS
18150		RY=RH+1./DIS
18200		J10=J10-1
18300		GO TO 4041
18400	C  P10= + NUM OF THICKNESSES TO WIGGLE
18500	
18600	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
18800		RZ=R9*RSTJ2*5.96
18900	C  USE P9 TO SET WIGGLE WIDTH.  P8 TO SET HGT.
19000		CALL NOZERO(R8)
19200		RD=R8*RST7*.5
19500		RJ=RD
19600		IF(RD.LT.1.)RD=1.
19700	421	R9=RX
19800		RW=R3Q
19900		RA=RZ+R3Q
20000		CALL LINES(RW,R9,3)
20100	410	R9=R9+RJ
20200		CALL LINES(RA,R9,2)
20300		R9=R9+RD
20400		CALL LINES(RA,R9,2)
20500		CALL EXCH(RA,RW)
20600		IF(R9.LT.RY)GO TO 410
20700		IF(J10.LE.0)RETURN
20800		R3Q=R3Q+1./DIS
20900		J10=J10-1
21000		GO TO 421
21100	C  VERTICAL WIGGLE   P10=+ NUM OF THICKNESSES.
21200	
21300	
21400	C  NEXT IS FOR BEAMS
21500	90	RMINI=RSTJ2
21600		RX=2.7*RSTJ2*5.96
21700	C******************************
21800		R6=RHORZ(R6)
21900		IF(R8.NE.0)GO TO 204
22000		IF(R10.GE.10)GO TO 204
22100		IF(J7)GO TO 204
22200		IF(R9.NE.0)GO TO 1
22300	C  R8=0 AND R9=NUM  -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLETS, ETC.)
22400	204	IF(R9.NE.0)R9=RHORZ(R9)
22500		IF(J7)GO TO 201
22600	200	IF(J10.LT.10)GO TO 91
22700	C NEXT FOR INNER, PARTIAL BEAMS
22800		R8=RHORZ(R8)
22900		R10=AMOD(R10,10.)
23000		GO TO(2,3,4),J10/10
23100	2	RH=R9+RX
23200		GO TO 1
23300	3	R8=R9-RX
23400	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
23500	4	RH=R8
23600	C  LEFT INNER POS.
23700		GO TO 1
23800	201	J7=-J7
23900	C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=DISP.
24000		CALL NOZERO(R10)
24100	C  ALWAYS AT LEAST 1 IN DISPLACEMENT
24200		J10=30
24300	C TO ACTIVATE PARTIAL BEAM SECTION
24400		IF(J9.NE.0)GO TO 202
24500	C  NEXT FOR TREM. WITHOUT OTHER BEAMS.
24600		RH=-1
24700		IF(J7.GE.20)RH=-RH
24800	CC203	R4=R4+R10*RH
24900	CC	CALL CENTX
25000		R5=R4+RH
25100		R9=R3
25200		R6=R3+22.*RMINI
25300	202	IF(R8.EQ.0)R8=4. 
25400		RX=R8*RMINI*2.98
25500		RH=R9+RX
25600		R9=R9-RX
25700		GO TO 1
25800	
25900	91	IF(J8.EQ.0)GO TO 1
26000		IF(J8.GT.0)GO TO 92
26100	C FOR J8=-(10+DN) OR -(20+DN)
26200		R9=R3+RX
26300		IF(J8.LE.-20)R9=R6-RX
26400	192	J8=-J8
26500	92	IF(J10.EQ.0)J10=MOD(J8,10)
26600	CC??? 4/75	J8=J8-J10
26700		IF(J10.EQ.0)J10=1
26800		R10=J10
26900	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
27000	1	IF(IABS(J4).LT.100)GO TO 97
27100		RMINI=.6*RSTJ2
27200		R5=AMOD(R5,100.0)
27300	C   SPACE BETWEEN BEAMS
27400	97	RJ=RMINI*11.
27500		RW=RMINI*RHGT
27600	C  DIST. UP OR DOWN FROM NOTE HEAD.
27700		RJA=R10*RJ
27800	C  DISPLACEMENT
27900		RD=R9
28000	C  POSITION 3
28100		RJX=CENTR-RW+RJA
28200	C  FINAL HEIGHT OF LEFT SIDE
28300	C  NEG R7=TREMOLO
28400		RX=MOD(J7,10)
28500		JJ2=J7-20
28600		RA=R6
28700	C  HORIZANTAL DIST.
28800		RJY=R5*RST7+POS-RST18-RW+RJA
28900	C   VERTICAL POS OF RIGHT SIDE.
29000		RW=R14*RMINI
29100		RY=1.
29200		IF(J7.GE.20)GO TO 98 
29300	C JUMP IF STEMS ARE DOWN
29400		RY=-RY
29500	C  FOR  THICKENING INCR.
29600		JJ2=J7-10
29700		RJ=-RJ
29800		RJA=RMINI*R2HGT-2.*RJA
29900		RJX=RJX+RJA
30000		RJY=RJY+RJA
30100		R3Q=R3Q+RW
30200	C  POSITION 1
30300		RA=RA+RW
30400	C  POSITION 2
30500		RD=RD+RW
30600	C******************************
30700		RH=RH+RW
30800	98	RSTJ2=RSTJ2*RBM
30900	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
31000	93	IF(JJ2.GT.RX)GO TO 94
31100		IF(J10.GE.10)GO TO 7
31200	C**********************
31300		IF(J8.EQ.0)GO TO 94
31400		R3=RW
31500		IF(J9.EQ.0)GO TO 292
31600	 	IF(J8.GE.20)GO TO 193
31700	293	RX=R3Q-RD
31800		GO TO 194
31900	7	RHX=RH-R3Q
32000		R3=RD-R3Q
32100		GO TO 292
32200	193	RX=RD-RA
32300	194	R3=ABS(RX)
32400	292	DISX=ABS(R3Q-RA)
32500		HGT=RJX-RJY
32600		IF(J10.GE.10)HGT1=HGT*RHX/DISX
32700	C**********************
32800		R3=R3/DISX
32900	195	HGT=HGT*R3
33000	196	L=J8/10
33100		J8=0
33200		IF(J10.GE.10)GO TO 8
33300	C***************
33400		IF(L.EQ.1)GO TO 95
33500	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
33600		R3Q=RD
33700		RJX=RJY+HGT
33800		GO TO 94
33900	C**************
34000	8	R3Q=RH
34100		RA=RD
34200		RJY=RJX-HGT
34300		RJX=RJX-HGT1
34400		GO TO 94
34500	95	RA=RD
34600		RJY=RJX-HGT
34700	94	L=7.*RMINI
34800	930	RC=0
34900	C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??
35000		CALL LINES(R3Q,RJX,3)
35100		DO 941 K=1,L
35200		CALL BMS
35300		IF(PLT.GE.0)GO TO 940
35400		RC=RC+RY
35500	C FOR THICKENING.
35600		CALL BMS
35700		CALL EXCH(RA,R3Q)
35800	941	CALL EXCH(RJY,RJX)
35900		CALL BMS
36000	C  DRAWS 5 LINES FOR BEAMS.
36100	940	JJ2=JJ2-1
36200		IF(JJ2.LE.0)GO TO 942
36300	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
36400		RJY=RJY+RJ
36500		RJX=RJX+RJ
36600		GO TO 930
36700	
36800	942	IF(R8.NE.0)RETURN
36900		IF(R9.EQ.0)RETURN
37000		IF(R10.GE.30)RETURN
37100	C FOR NUMBERS OUTSIDE BEAMS
37200		RSTJ2=RMINI
37300		RD=-10.
37500		IF(R7.LT.20)RD=8.3
37800	943	J3=R3Q+(RA-R3Q)/2.
37900		R6=1.
37950		R4=AMOD(R4,100.)
38000		R4=R4+(R5-R4)/2.+RD
38100		R7=1
38200	C ITALICS
38300		CALL MAKNUM(R9)
38400		RETURN
38500	
38600	100	RA=0
38700	C  FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S), 
38800	C  P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
38900	C  P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS. 
39000	C  PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
39100		IF(R5.EQ.0)R5=RSTFAC(J2)
39200		CALL NOZERO(R5)
39300		RSTFAC(J2)=R5
39400		RX=(J2+3)*123-369.+R4*7.*R5
39600	CC	RC=R5
39700		STFF(J2)=RX
39800		RX=RX+RTF*R5
39900	C  FOR RTF SEE DATA
39930		RA=RX
40000	C  FOR 2 PASS PLOTTING
40100		RJ=RHORZ(R6)
40200		IF(R6.EQ.0)RJ=596
40300		R5=R5*14.
40400		IF(R8.EQ.0)GO TO 68
40500		IF(PLT)GO TO 68
40600		RZ=RX+R8*167.
40700	C  167 IS A MAGIC NUMBER!!  PUTS LINE ON DPY.
40800		CALL LINX(R3,RZ,RJ,RZ)
40900	C  SHOWS WHERE NEXT STAFF 0 WILL BE.
41000	68	IF(J7.EQ.0)GO TO 101
41100		IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
41200	C  TO ACTIVATE DPY BUFFER
41300		RETURN
41400	101	DO 6 K=1,5
41500		RZ=RJ
41600		RW=R3
41700		IF(K.EQ.2)GO TO 66
41800		IF(K.NE.4)GO TO 67
41900	66	CALL EXCH(RW,RZ)
42000	67	CALL LINX(RZ,RX,RW,RX)
42100	6	RX=RX+R5
42200		IF(RA.EQ.1000)RETURN
42300		IF(PLT.NE.-2)RETURN
42400		RX=RA-1./RHT
42500	CC	R5=RC
42600		RA=1000
42700		GO TO 101
42800		END
42900	
43000	CC	SUBROUTINE BMS
43100	CC	COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RJY
43200	CC	CALL LINES(RA,RJY+RC*RSTJ2,2)
43300	CC	END
43400	
43500		SUBROUTINE METER
43600	      COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
43700		EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
43800		1,(R8,RJQ(6))
43900	
44000	C  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
44100	
44200		CALL NOZERO(R7)
44300		JZ=J3
44400		RY=R4+8.*R7
44500	C  HEIGHT
44600		RW=R6
44700	C  BOTTOM NUM
44800	C  P5=TOP NUM
44900		R6=R7
45000		RR6=R6
45100	C  SIZE
45200	C  FOR BDR40  -- OR =1
45300		M=0
45400		R4=RY
45500	2	R7=0
45600	C  R7=0 FOR BDR FONT??
45700	CC	IF(R5.NE.99)GO TO 1
45800		IF(R5.NE.99)GO TO 3
45900	C  99 AS METER = 'C'
46000		M=-1
46100		R5=9999.
46200		GO TO 3
46300	C  TO CENTER 12S AND 16S
46400	3	CALL MAKNUM(R5)
46500		IF(M)RETURN
46600	C  STICK AROUND FOR BOTTOM NUM
46700		M=-1
46800		R4=RY-4.*RR6
46900		R6=RR6
47000		R5=RW
47100	C  GET BOTTOM NUM
47200		J3=JZ
47300		R8=0
47400		GO TO 2
47500		END
47600	
47700	CF	SUBROUTINE RNOTE(X)
47800	CF	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
47900	CF	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
48000	CF	END
48100	
48200		SUBROUTINE MAKNUM(RNUM)
48300		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
48400		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
48500	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
48600		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
48700		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
48800		DATA RS/10.0/,RBX/1.0/
48900		RB8=R8
49000		J3X=J3
49100	C P7=0=BDR40; =1=BDI40; =2=PRIM.
49200		CALL NOZERO(R6)
49300		R5=R6
49400	C  UPPER CASE - BDR40
49500		R6=480000.00+(R7+50.)*100.
49600		R7=999999.99
49700	C  BLANKS
49800		R8=R7
49900		IF(RNUM.NE.9999.)GO TO 2
50000	C  NEXT FOR 'C'OMMON TIME
50100		RNUM=12.
50200	C  MAKES A 'C'
50300		R4=R4-2.2
50400	C  .2 FOR BAD POS. OF LETTERS
50500		GO TO 4
50600	
50700	2	ONE=0 
50800		IF(RNUM.EQ.1.)ONE=3.
50900		IF(RNUM.GT.9.)GO TO 3
51000	C  JUMP FOR 2 OR 3 DIGIT NUMBER
51100	4	R6=R6+RNUM+.47
51200	C  PUTS BLANK ON END (.47)
51300		GO TO 1
51400	
51500	3	RJY=10.
51600		IF(RNUM.GE.100.)RJY=100.
51700		B=IFIX(RNUM/RJY)
51800		C=AMOD(RNUM,RJY)
51900		IF(RNUM.LT.100)GO TO 7
52000		D=IFIX(C/10.)
52100		C=AMOD(C,10.)
52200		IF(C.EQ.1.)ONE=ONE+3.
52300		R7=C*10000.+9999.99
52400		C=D
52500	7	R6=R6+B+C/100.
52600		IF(B.EQ.1.)ONE=ONE+3.
52700		IF(C.EQ.1.)ONE=ONE+3.
52800		B=R5
52900		IF(RNUM.GE.100.)B=B*2
53000		J3=J3-RS*RSTJ2*B
53100	C  FOR 2 DIGIT NUMBER
53200	CCC	IF(RNUM.GE.20.)GO TO 6
53300	CCC	IF(JA.EQ.18)GO TO 6
53400	CCC	RJY=5.6
53500	CCC	IF(RNUM.GT.11.)RJY=3.
53600	C  ADJUSTS FOR 11, ETC.
53700	CCC	J2=J2+RJY*R5*RSTJ2
53800	CC6	J3=J2
53900	1	J3=J3+ONE*R5*RSTJ2
54000	C CENTERS THE NUMBER '1'
54100		CALL ALPHA
54200		J3=J3X
54300		IF(RB8.EQ.0)RETURN
54400	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
54500		R3=J3-R5
54600		IF(J10.EQ.0)J10=1
54700	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
54800		IF(RNUM.GT.9)R3=R3+R5*RBX
54900	C  TO SET CENTER
55000		IF(RB8.EQ.2)GO TO 5
55100		R4=R4+R5+.1+.05/R5
55150	C  END OF ABOVE IS FOR SMALL CIRCLES.
55200		B=4.5
55300		IF(RNUM.GE.100.)B=5.5
55400		R5=R5*B
55500		JA=12
55600		J6=0
55700		J7=0
55800		J8=J10
55900		CALL CENTX
56000		CALL SLUR
56100		RETURN
56200	
56300	5	JA=4
56400		B=6
56500		R9=0
56600		IF(RNUM.LT.100.)GO TO 8
56700		B=10.
56800		R9=R5*6.
56900	C  MAKES RECTANGLE IF ≥100
57000	8	R4=R4+R5*.7+.1
57100		R8=R5*B
57200		J5=50
57300		CALL ITMSUB
57400	C  RETURNS ORIG. HORIZ. POS.
57500		END
57600	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
57700	
57800	CC	FUNCTION IABS(N)
57900	C  BECAUSE IABS IN LIB40 HAS A BUG.
58000	CC	IABS=N
58100	CC	IF(N)IABS=-N
58200	CC	END
58300	
58400	CF	SUBROUTINE DRWNT(RMINI)
58500	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
58600	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
58700	CF	EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
58800	CF	1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
58900	CF	1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
59000	CF	RJX=CENTR
59100	CF	JH=0
59200	C  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
59300	CC	CENTR=CENTR-21.*RSTJ2
59400	CF	RA=R6
59500	CF	R6=.5*RMINI/RSTJ2
59600	CF	R7=R6
59700	CF	RJD=RJZ-3
59800	CCXX	IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
59900	C  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
60000	CF	JI=0
60100	CF	CALL CLEFS
60200	CF	JI=R9
60300	C  ↑↑↑↑↑↑ NEEDED??
60400	C  FIX THIS???? ↑↑↑↑↑
60500	C  FOR WHITE NOTES AND ACCIS ON PLOTTER.
60600	CF	CENTR=RJX
60700	CF	R6=RA
60800	CF	R7=JG
60900	CF	JE=RJE
61000	CF	END
61100	
61200	CC	FUNCTION RHORZ(R)
61300	CC	RHORZ=R*5.96-596.
61400	CC	END
61500	
61600	CF	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
61700	C   TO X,Y INTO ONE WORD
61800	CF	DIMENSION XY(1)
61900	CF	DO 2 K=I,IFIX(S)
62000	CF	L=2
62100	CF	Y=XY(K)
62200	CF	IF(Y.LT.1000.)GO TO 3
62300	CF	L=3
62400	CF	Y=Y-1000.
62500	C   >1000 = INVIS. LINE
62600	CF3	M=Y
62700	CF	Y=(Y-M)*1000.
62800	CF	IF(Y.GT.100.)Y=100-Y
62900	C   Y NUMBERS .GT.100 ARE NEG.
63000	CF	B=Y*X+CENTR
63100	CF	IF(M.GT.60)M=100-M
63200	CF	A=M*RMINI+R3
63300	CF2	CALL LINES(A,B,L)
63400	CF	END
63500		
63600	CC	FUNCTION EEXP(X,Y)
63700	CC	EEXP=X**Y
63800	CC	END